(* ::Package:: *)

(************************************************************************)
(* This file was generated automatically by the Mathematica front end.  *)
(* It contains Initialization cells from a Notebook file, which         *)
(* typically will have the same name as this file except ending in      *)
(* ".nb" instead of ".m".                                               *)
(*                                                                      *)
(* This file is intended to be loaded into the Mathematica kernel using *)
(* the package loading commands Get or Needs.  Doing so is equivalent   *)
(* to using the Evaluate Initialization Cells menu command in the front *)
(* end.                                                                 *)
(*                                                                      *)
(* DO NOT EDIT THIS FILE.  This entire file is regenerated              *)
(* automatically each time the parent Notebook file is saved in the     *)
(* Mathematica front end.  Any changes you make to this file will be    *)
(* overwritten.                                                         *)
(************************************************************************)



<<ACPackages`


(* ::Subsection::Closed:: *)
(*\:041f\:043e\:0441\:0442\:0440\:043e\:0435\:043d\:0438\:0435 \:0441\:0438\:0441\:0442\:0435\:043c\:044b \:0438 \:043c\:0430\:0442\:0440\:0438\:0446*)


U[r_]:=1-r^2;


eqs\[Phi]r[\[Lambda]_,k_,m_,Re_]:={-3 vr[r]+3 m^2 vr[r]+2 k^2 r^2 vr[r]+k^2 m^2 r^2 vr[r]+k^4 r^4 vr[r]-\[ImaginaryI] k r^2 Re vr[r]+\[ImaginaryI] k r^4 Re vr[r]-\[ImaginaryI] k^3 r^4 Re vr[r]+\[ImaginaryI] k^3 r^6 Re vr[r]+r^2 Re \[Lambda] vr[r]+k^2 r^4 Re \[Lambda] vr[r]-3 \[ImaginaryI] m v\[Phi][r]+3 \[ImaginaryI] m^3 v\[Phi][r]+3 \[ImaginaryI] k^2 m r^2 v\[Phi][r]+k m r^2 Re v\[Phi][r]+k m r^4 Re v\[Phi][r]+\[ImaginaryI] m r^2 Re \[Lambda] v\[Phi][r]+3 r 
\!\(\*SuperscriptBox["vr", "\[Prime]",
MultilineFunction->None]\)[r]+m^2 r 
\!\(\*SuperscriptBox["vr", "\[Prime]",
MultilineFunction->None]\)[r]-2 k^2 r^3 
\!\(\*SuperscriptBox["vr", "\[Prime]",
MultilineFunction->None]\)[r]+\[ImaginaryI] k r^3 Re 
\!\(\*SuperscriptBox["vr", "\[Prime]",
MultilineFunction->None]\)[r]-\[ImaginaryI] k r^5 Re 
\!\(\*SuperscriptBox["vr", "\[Prime]",
MultilineFunction->None]\)[r]-r^3 Re \[Lambda] 
\!\(\*SuperscriptBox["vr", "\[Prime]",
MultilineFunction->None]\)[r]+3 \[ImaginaryI] m r 
\!\(\*SuperscriptBox["v\[Phi]", "\[Prime]",
MultilineFunction->None]\)[r]-\[ImaginaryI] m^3 r 
\!\(\*SuperscriptBox["v\[Phi]", "\[Prime]",
MultilineFunction->None]\)[r]-\[ImaginaryI] k^2 m r^3 
\!\(\*SuperscriptBox["v\[Phi]", "\[Prime]",
MultilineFunction->None]\)[r]-k m r^3 Re 
\!\(\*SuperscriptBox["v\[Phi]", "\[Prime]",
MultilineFunction->None]\)[r]+k m r^5 Re 
\!\(\*SuperscriptBox["v\[Phi]", "\[Prime]",
MultilineFunction->None]\)[r]-\[ImaginaryI] m r^3 Re \[Lambda] 
\!\(\*SuperscriptBox["v\[Phi]", "\[Prime]",
MultilineFunction->None]\)[r]-3 r^2 
\!\(\*SuperscriptBox["vr", "\[Prime]\[Prime]",
MultilineFunction->None]\)[r]-m^2 r^2 
\!\(\*SuperscriptBox["vr", "\[Prime]\[Prime]",
MultilineFunction->None]\)[r]-2 k^2 r^4 
\!\(\*SuperscriptBox["vr", "\[Prime]\[Prime]",
MultilineFunction->None]\)[r]+\[ImaginaryI] k r^4 Re 
\!\(\*SuperscriptBox["vr", "\[Prime]\[Prime]",
MultilineFunction->None]\)[r]-\[ImaginaryI] k r^6 Re 
\!\(\*SuperscriptBox["vr", "\[Prime]\[Prime]",
MultilineFunction->None]\)[r]-r^4 Re \[Lambda] 
\!\(\*SuperscriptBox["vr", "\[Prime]\[Prime]",
MultilineFunction->None]\)[r]-2 \[ImaginaryI] m r^2 
\!\(\*SuperscriptBox["v\[Phi]", "\[Prime]\[Prime]",
MultilineFunction->None]\)[r]+2 r^3 
\!\(\*SuperscriptBox["vr", 
TagBox[
RowBox[{"(", "3", ")"}],
Derivative],
MultilineFunction->None]\)[r]+\[ImaginaryI] m r^3 
\!\(\*SuperscriptBox["v\[Phi]", 
TagBox[
RowBox[{"(", "3", ")"}],
Derivative],
MultilineFunction->None]\)[r]+r^4 
\!\(\*SuperscriptBox["vr", 
TagBox[
RowBox[{"(", "4", ")"}],
Derivative],
MultilineFunction->None]\)[r],\[ImaginaryI] m vr[r]-\[ImaginaryI] m^3 vr[r]-3 \[ImaginaryI] k^2 m r^2 vr[r]-k m r^2 Re vr[r]-k m r^4 Re vr[r]-\[ImaginaryI] m r^2 Re \[Lambda] vr[r]-m^2 v\[Phi][r]+m^4 v\[Phi][r]+k^2 r^2 v\[Phi][r]+2 k^2 m^2 r^2 v\[Phi][r]+k^4 r^4 v\[Phi][r]-\[ImaginaryI] k m^2 r^2 Re v\[Phi][r]-\[ImaginaryI] k^3 r^4 Re v\[Phi][r]+\[ImaginaryI] k m^2 r^4 Re v\[Phi][r]+\[ImaginaryI] k^3 r^6 Re v\[Phi][r]+m^2 r^2 Re \[Lambda] v\[Phi][r]+k^2 r^4 Re \[Lambda] v\[Phi][r]-\[ImaginaryI] m r 
\!\(\*SuperscriptBox["vr", "\[Prime]",
MultilineFunction->None]\)[r]-\[ImaginaryI] m^3 r 
\!\(\*SuperscriptBox["vr", "\[Prime]",
MultilineFunction->None]\)[r]-\[ImaginaryI] k^2 m r^3 
\!\(\*SuperscriptBox["vr", "\[Prime]",
MultilineFunction->None]\)[r]-k m r^3 Re 
\!\(\*SuperscriptBox["vr", "\[Prime]",
MultilineFunction->None]\)[r]+k m r^5 Re 
\!\(\*SuperscriptBox["vr", "\[Prime]",
MultilineFunction->None]\)[r]-\[ImaginaryI] m r^3 Re \[Lambda] 
\!\(\*SuperscriptBox["vr", "\[Prime]",
MultilineFunction->None]\)[r]+m^2 r 
\!\(\*SuperscriptBox["v\[Phi]", "\[Prime]",
MultilineFunction->None]\)[r]-k^2 r^3 
\!\(\*SuperscriptBox["v\[Phi]", "\[Prime]",
MultilineFunction->None]\)[r]+2 \[ImaginaryI] m r^2 
\!\(\*SuperscriptBox["vr", "\[Prime]\[Prime]",
MultilineFunction->None]\)[r]-m^2 r^2 
\!\(\*SuperscriptBox["v\[Phi]", "\[Prime]\[Prime]",
MultilineFunction->None]\)[r]-k^2 r^4 
\!\(\*SuperscriptBox["v\[Phi]", "\[Prime]\[Prime]",
MultilineFunction->None]\)[r]+\[ImaginaryI] m r^3 
\!\(\*SuperscriptBox["vr", 
TagBox[
RowBox[{"(", "3", ")"}],
Derivative],
MultilineFunction->None]\)[r]};


(* ::Input::Closed:: *)
(*(*\:041a\:0420\:0421 \:0441 \:0446\:0435\:043b\:043e\:0447\:0438\:0441\:043b\:0435\:043d\:043d\:043e\:0439 \:0441\:0435\:0442\:043a\:043e\:0439 \:0438 \:043e\:0434\:0438\:043d\:0430\:043a\:043e\:0432\:044b\:043c\:0438 \:0440\:0430\:0437\:043d\:043e\:0441\:0442\:044f\:043c\:0438*)*)


(* ::Input:: *)
(*FiniteMatrix4Eigen[n_,sample_:5,subst___]:=Block[{h=1/n,krseq,krs,unk,unkmain,unkfict,i,sm,s,order,lhs,rhs,gh,\[Omega]},*)
(*sm=Max[sample,5];*)
(*gh=(sm-1)/2;*)
(*unk=Join[Table[Subscript[f, i],{i,0-(sm-1)/2,n+(sm-1)/2}],Table[Subscript[g, i],{i,0-(sm-1)/2,n+(sm-1)/2}]];*)
(*unkmain=Join[Table[Subscript[f, i],{i,1,n-1}],Table[Subscript[g, i],{i,1,n-1}]];*)
(*unkfict=Complement[unk,unkmain];dersam[buk_,order_,s_]:=Table[Subscript[buk, j],{j,i-(s-1)/2,i+(s-1)/2}].NDCoefficientList[order,s]/h^order;*)
(*rhs=\[Omega]/k (f''[z]-k^2 f[z])/.{z->i h,f[z]->Subscript[f, i],f''[z]->dersam[2,sm],f''''[z]->dersam[4,sm]}/.{subst};*)
(*lhs=Simplify[(eqOZ[\[Omega],k,R]+\[Omega]/k (f''[z]-k^2 f[z]))]/.{z->i h,f[z]->Subscript[f, i],f''[z]->dersam[2,sm],f''''[z]->dersam[4,sm]}/.{subst};*)
(*virfict={Subscript[f, -2]->6Subscript[f, 0]-8Subscript[f, 1]+3Subscript[f, 2],Subscript[f, -1]->3Subscript[f, 0]-3Subscript[f, 1]+Subscript[f, 2],Subscript[f, 0]->0,Subscript[f, n]->0,Subscript[f, n+1]->3Subscript[f, n]-3Subscript[f, n-1]+Subscript[f, n-2],Subscript[f, n+2]->6Subscript[f, n]-8Subscript[f, n-1]+3Subscript[f, n-2]};*)
(*fict=unkfict/.virfict;*)
(*rhs=Coefficient[#,unkmain]&/@(Table[rhs,{i,1,n-1}]/.virfict)/\[Omega];*)
(*(*Print[rhs//TableForm];*)*)
(*lhs=Coefficient[#,unkmain]&/@(Table[lhs,{i,1,n-1}]/.virfict);*)
(*(*Print["next:"];*)
(*Print[lhs//TableForm];*)*)
(*(*Return[rhs.Inverse[lhs]];*)*)
(*Return[{lhs,rhs}];*)
(*];*)


(* ::Input::Closed:: *)
(*(*\:041a\:0420\:0421 \:0441 \:0434\:0440\:043e\:0431\:043d\:043e\:0439 \:0441\:0435\:0442\:043a\:043e\:0439 \:0438 \:0446\:0435\:043d\:0442\:0440\:0430\:043b\:044c\:043d\:044b\:043c\:0438 \:0440\:0430\:0437\:043d\:043e\:0441\:0442\:044f\:043c\:0438-current*)*)


FiniteMatrix4Eigen[n_,m_,(*sample_:5,*)subst___]:=Block[{h=1/n,unk,unkmain,unkfict,i,sm,s,order,lhs,rhs,\[Omega]},
sm=Max[sample,5];
sm=5;
gh=(sm-1)/2;
unk=Join[Table[Subscript[f, i+1/2],{i,0-(sm-1)/2,n+(sm-1)/2-1}],Table[Subscript[g, i+1/2],{i,-1,n}]];
unkmain=Join[Table[Subscript[f, i],{i,1/2,n-1/2}],Table[Subscript[g, i],{i,1/2,n-1/2}]];
unkfict=Complement[unk,unkmain];
dersam[buk_,order_,s_]:=Table[Subscript[buk, j],{j,i-(s-1)/2,i+(s-1)/2}].NDCoefficientList[order,s]/h^order;
subs=Join[{r->i h},{vr[r_]->Subscript[f, i],vr'[r_]->dersam[f,1,sm],vr''[r_]->dersam[f,2,sm],vr'''[r_]->dersam[f,3,sm],vr''''[r_]->dersam[f,4,sm]},{v\[Phi][r_]->Subscript[g, i],v\[Phi]'[r_]->dersam[g,1,sm],v\[Phi]''[r_]->dersam[g,2,sm],v\[Phi]'''[r_]->dersam[g,3,sm],v\[Phi]''''[r_]->dersam[g,4,sm]},{subst}];
rhs=-D[eqs\[Phi]r[\[Omega],k,m,R],\[Omega]]/.subs;
lhs=Simplify[(eqs\[Phi]r[\[Omega],k,m,R]-\[Omega] D[eqs\[Phi]r[\[Omega],k,m,R],\[Omega]])]/.subs;
bc={dersam[f,0,sm-1]/.i->n,(dersam[f,1,sm-1]+dersam[f,0,sm-1])/.i->n,dersam[g,0,sm-1]/.i->n};
bc=If[OddQ[m],Join[bc,{dersam[f,1,sm-1]/.i->0,dersam[g,1,sm-1]/.i->0,(dersam[f,0,sm-1]+\[ImaginaryI] m dersam[g,0,sm-1])/.i->0}],Join[bc,{dersam[f,0,sm-1]/.i->0,dersam[g,0,sm-1]/.i->0,(dersam[f,1,sm-1]+\[ImaginaryI] m dersam[g,1,sm-1])/.i->0}]];
virfict=First[Solve[Thread[bc==0],unkfict]];
fict=unkfict/.virfict;rhs=Coefficient[#,unkmain]&/@Flatten[Table[rhs,{i,1/2,n-1/2}]/.virfict];
lhs=Coefficient[#,unkmain]&/@Flatten[Table[lhs,{i,1/2,n-1/2}]/.virfict];
(*rhs=Coefficient[#,unk]&/@Join[Table[0,{i,2},{j,n+sm-1}],Table[rhs,{i,1/2,n-1/2}]/\[Omega],Table[0,{i,2},{j,n+sm-1}]];
lhs=Coefficient[#,unk]&/@Join[{dersam[0,sm-1]/.i->0,dersam[1,sm-1]/.i->0},Table[lhs,{i,1/2,n-1/2}],{dersam[1,sm-1]/.i->n,dersam[0,sm-1]/.i->n}];*)
(*Return[rhs.Inverse[lhs]];*)
Return[{lhs,rhs}];
];


(* ::Subsection::Closed:: *)
(*\:0424\:0443\:043d\:043a\:0446\:0438\:0438 \:043d\:0430\:0445\:043e\:0436\:0434\:0435\:043d\:0438\:044f \:0438\:043d\:043a\:0440\:0435\:043c\:0435\:043d\:0442\:043e\:0432*)


(* ::Input:: *)
(*(*\:041f\:043e\:043b\:0443\:0447\:0435\:043d\:0438\:0435 \:0441.\:0437. \:0438 \:0441.\:0432. \:0441 \:043f\:043e\:043c\:043e\:0449\:044c\:044e Eigen...[Inverse[a].m]*)*)


(* ::Input:: *)
(*GetIncrements[n_,m_,k1_,R1_]:=Eigenvalues[Inverse[Last[#]].First[#]&[N[FiniteMatrix4Eigen[n,m,k->k1,R->R1]]]];*)


(* ::Input:: *)
(*GetEigenWave[n1_,m_,k1_,R1_,mode_:1]:=Block[{eigval,eigvec,nom,syst},syst=Inverse[Last[#]].First[#]&[N[FiniteMatrix4Eigen[n1,m,k->k1,R->R1]]];*)
(*{eigval,eigvec}=Select[Transpose[Eigensystem[syst]],NumericQ[First[#]]&]//Transpose;*)
(*nom=Flatten[Position[eigval,Sort[eigval,Re[#1]>Re[#2]&][[mode]]]]//First;*)
(*Print["Main eigen value is ",eigval[[nom]]];*)
(*Return[eigvec[[nom]]];];*)


(* ::Input:: *)
(*(*\:041f\:043e\:043b\:0443\:0447\:0435\:043d\:0438\:0435 \:0441.\:0437. \:0438 \:0441.\:0432. \:0441 \:043f\:043e\:043c\:043e\:0449\:044c\:044e Eigen...[{m,a}]*)*)


GetIncrements[n_,m_,k1_,R1_]:=Select[Eigenvalues[N[FiniteMatrix4Eigen[n,m,k->k1,R->R1]]],NumericQ];


GetEigenWave[n1_,m_,k1_,R1_,mode_:1]:=Block[{eigval,eigvec,nom,syst},syst=N[FiniteMatrix4Eigen[n1,m,k->k1,R->R1]];
{eigval,eigvec}=Select[Transpose[Eigensystem[syst]],NumericQ[First[#]]&]//Transpose;
nom=Flatten[Position[eigval,Sort[eigval,Re[#1]>Re[#2]&][[mode]]]]//First;
Print["Main eigen value is ",eigval[[nom]]];
Return[eigvec[[nom]]];];


GetMainIncrement[n_,m_,k1_,R1_,num_:1]:=(*GetMainIncrement[n,k1,R1,num]=*)Take[Sort[Re/@GetIncrements[n,m,k1,R1]],{-num}]//First;


(* ::Input:: *)
(*Take[Sort[GetIncrements[20,0,1,100],Re[#1]>Re[#2]&],10]*)


(* ::Input:: *)
(*GetMainIncrement[20,0,1,100,2]*)


(* ::Input:: *)
(*Sort[GetIncrements[20,0,10^-4,10],Re[#1]>Re[#2]&]*)


(* ::Input:: *)
(*(*\:041e\:0442\:043a\:043b\:043e\:043d\:0435\:043d\:0438\:044f \:0432 \:043e\:043f\:0440\:0435\:0434\:0435\:043b\:0438\:0442\:0435\:043b\:0435 \:043f\:043e\:0441\:043b\:0435 \:043f\:043e\:0434\:0441\:0442\:0430\:043d\:043e\:0432\:043a\:0438 \:0441\:043e\:0431\:0441\:0442\:0432\:0435\:043d\:043d\:043e\:0433\:043e \:0437\:043d\:0430\:0447\:0435\:043d\:0438\:044f*)
(*With[{n2=3,m=0,k2=1,R2=100,mod=1},Det[SetPrecision[First[#]-Sort[GetIncrements[n2,m,k2,R2],Re[#1]>Re[#2]&][[mod]]Last[#],1000]]&[SetPrecision[FiniteMatrix4Eigen[n2,m,k->k2,R->R2],1000]]]*)*)


(* ::Input::Closed:: *)
(*(*\:041e\:0442\:043a\:043b\:043e\:043d\:0435\:043d\:0438\:044f \:0432 \:0432\:0435\:043a\:0442\:043e\:0440\:0435 \:043f\:043e\:0441\:043b\:0435 \:043f\:043e\:0434\:0441\:0442\:0430\:043d\:043e\:0432\:043a\:0438 \:0441\:043e\:0431\:0441\:0442\:0432\:0435\:043d\:043d\:044b\:0445 \:0437\:043d\:0430\:0447\:0435\:043d\:0438\:0439 \:0438 \:0432\:0435\:043a\:0442\:043e\:0440\:043e\:0432*)*)
(*With[{n2=300,m=0,k2=1,R2=1000,mod=2},(First[#]-Sort[GetIncrements[n2,m,k2,R2],Re[#1]>Re[#2]&][[mod]]Last[#]).GetEigenWave[n2,m,k2,R2,mod]&[FiniteMatrix4Eigen[n2,m,k->k2,R->R2]]]//Abs//PrintRange;*)


(* ::Input:: *)
(*?GetMainIncrement*)


(* ::Input:: *)
(*ShowPlot[Re[Take[SortBy[N[GetIncrements[#,0,1,1]],Re],-5]]&,{5,200},All]*)


(* ::Input:: *)
(*ShowPlot[GetMainIncrement[Floor[#],0,1,1,2]&,{10,200},All,PlotPoints->5,MaxRecursion->1]*)


(* ::Input:: *)
(*GetMainIncrement[100,#,1,1,2]&/@Range[0,5]*)


(* ::Input:: *)
(*ShowPlot[-GetMainIncrement[100,0,0.001,#,2]&,{1,100}]*)


(* ::Input::Closed:: *)
(*incrs=Sort[N[GetIncrements[100,2,0.01,300]],Re[#1]>Re[#2]&];*)
(*Print[Re[incrs[[2]]]];*)
(*Show[Graphics[{PointSize[0.01`],(Point[{Re[#1],Im[#1]}]&)/@incrs}],Axes->True,PlotRange->{{-300,0},{0.005,0.008}},AspectRatio->1/GoldenRatio]*)


(* ::Input:: *)
(*Sort[GetIncrements[300,1.,10000],Im[#1]<Im[#2]&]*)


(* ::Subsection:: *)
(*\:0412\:0438\:0437\:0443\:0430\:043b\:0438\:0437\:0430\:0446\:0438\:044f \:0441\:043e\:0431\:0441\:0442\:0432\:0435\:043d\:043d\:044b\:0445 \:0444\:0443\:043d\:043a\:0446\:0438\:0439*)


(* ::Input:: *)
(*Timing[{ewvr,ewv\[Phi]}=Partition[#,Length[#]/2]&[GetEigenWave[100,1,1,1,2]];]*)
(*PrintRange[Re[#]]&/@{ewvr,ewv\[Phi]}*)
(*PrintRange[Im[#]]&/@{ewvr,ewv\[Phi]}*)


(* ::Input:: *)
(*With[{m=1},ListVectorPlot[Flatten[CutList[Table[{i/Length[ewvr] {Sin[u],Cos[u]},Re[E^(\[ImaginaryI] m u) (ewvr[[i]]i/Length[ewvr] {Sin[u],Cos[u]}+ewv\[Phi][[i]]i/Length[ewvr] {-Cos[u],Sin[u]})]},{i,1,Length[ewvr]},{u,3\[Pi]/2,5\[Pi]/2,\[Pi]/10}],50],1]]]*)


(* ::Input:: *)
(*Block[{ew=Re/@GetEigenWave[100,1,1,1,2],fs},*)
(*fs=fict/.{Subscript[f, b_]:>ew[[b+1/2]]};*)
(*gr=PrintRange[alllist=Join[Take[fs,Length[fs]/2],ew,Take[fs,-Length[fs]/2]]]*)
(*]*)


(* ::Subsection::Closed:: *)
(*\:0420\:0430\:0437\:043b\:0438\:0447\:043d\:044b\:0435 \:0437\:0430\:0432\:0438\:0441\:0438\:043c\:043e\:0441\:0442\:0438 \:0438\:043d\:043a\:0440\:0435\:043c\:0435\:043d\:0442\:043e\:0432*)


(* ::Subsubsection:: *)
(*\:041e\:0442 \:0447\:0438\:0441\:043b\:0430 \:0420\:0435\:0439\:043d\:043e\:043b\:044c\:0434\:0441\:0430 Re*)


(* ::Input:: *)
(*Plot[Re[GetMainIncrement[100,0,0.1`,R,2]],{R,1,20000}]*)


(* ::Input:: *)
(*{m=0,k=0.1,n=100}*)


(* ::Input:: *)
(*{m=1,k=0.1,n=100}*)


(* ::Input:: *)
(*{m=0,k=1,n=100}*)


(* ::Input:: *)
(*{m=1,k=1,n=20}*)


(* ::Input:: *)
(*linc=Table[{R,GetMainIncrement[100,0,1,R,2]},{R,1,20001,100}];*)


(* ::Input:: *)
(*lincRe=Table[{R=10^logR,Take[Sort[GetIncrements[20,0,0.1,R],Re[#1]>Re[#2]&],10]},{logR,0,5,1/5}];*)


(* ::Text:: *)
(*\:0414\:043e\:043a\:0430\:0437\:0430\:0442\:0435\:043b\:044c\:0441\:0442\:0432\:043e \:0430\:0431\:0441\:043e\:043b\:044e\:0442\:043d\:043e\:0439 \:0443\:0441\:0442\:043e\:0439\:0447\:0438\:0432\:043e\:0441\:0442\:0438 (\:0435\:0441\:0442\:044c \:0441\:0445\:043e\:0434\:0438\:043c\:043e\:0441\:0442\:044c \:043f\:043e \:0441\:0435\:0442\:043a\:0435 \:0438 \:044d\:043a\:0441\:043f\:043e\:043d\:0435\:043d\:0446\:0438\:0430\:043b\:044c\:043d\:043e\:0435 \:043f\:0440\:0438\:0431\:043b\:0438\:0436\:0435\:043d\:0438\:0435 \:0438\:043d\:043a\:0440\:0435\:043c\:0435\:043d\:0442\:0430 \:043a \:043d\:0443\:043b\:044e \:0441\:043d\:0438\:0437\:0443*)


(* ::Input:: *)
(*Plot[Log[10,-GetMainIncrement[150,1,0.01`,Evaluate[10^logre],2]],{logre,0,7}]*)


(* ::Input:: *)
(*Plot[Log[10,-GetMainIncrement[100,0,0.3`,Evaluate[10^logre],2]],{logre,0,7}]*)


(* ::Input:: *)
(*Plot[Log[10,-GetMainIncrement[50,0,0.001`,Evaluate[10^logre],2]],{logre,0,7}]*)


(* ::Input:: *)
(*Plot[Log[10,-GetMainIncrement[50,0,1,Evaluate[10^logre],2]],{logre,0,7}]*)


(* ::Subsubsection:: *)
(*\:041e\:0442 \:0440\:0430\:0437\:043c\:0435\:0440\:0430 \:0441\:0435\:0442\:043a\:0438 (\:0441\:0445\:043e\:0434\:0438\:043c\:043e\:0441\:0442\:044c) n*)


(* ::Input:: *)
(*Timing[linc=Table[{n,(GetMainIncrement[n,0,1,1000,2])},{n,1,100,1}];]*)


(* ::Input:: *)
(*Monitor[linc1=Table[{n,(Take[Sort[GetIncrements[n,0,1,1],Re[#1]>Re[#2]&],10])},{n,5,200,5}];,n]*)


(* ::Input:: *)
(*With[{nummod=2},gr=PrintRange[{#[[1]],Re[#[[2,nummod]]]}&/@(Drop[linc1,5]/.{Take->(#1&)})]]*)


(* ::Input:: *)
(*(*\:041d\:0430\:0445\:043e\:0436\:0434\:0435\:043d\:0438\:0435 \:043f\:0440\:0435\:0434\:0435\:043b\:043e\:0432 \:043f\:043e \:0440\:0430\:0437\:043c\:0435\:0440\:0443 \:0441\:0435\:0442\:043a\:0438*)*)
(*ListLimit[#,ApproximationReport->None]&/@(Transpose[{First/@Take[linc1,-Length[#]],#}]&/@Re[Transpose[Last/@Drop[linc1,8]]])*)


(* ::Subsubsection:: *)
(*\:041e\:0442 \:043d\:043e\:043c\:0435\:0440\:0430 \:043c\:043e\:0434\:044b m*)


(* ::Input:: *)
(*With[{n=50,k=0.05,R=10000},{GetMainIncrement[n,0,k,R,2],GetMainIncrement[n,1,k,R,2],GetMainIncrement[n,2,k,R,2],GetMainIncrement[n,3,k,R,2]}]*)


(* ::Subsubsection:: *)
(*\:0421\:043f\:0438\:0441\:043a\:0438 \:0438\:043d\:043a\:0440\:0435\:043c\:0435\:043d\:0442\:043e\:0432 \:0434\:043b\:044f \:043d\:0435\:0441\:043a\:043e\:043b\:044c\:043a\:0438\:0445 \:043c\:043e\:0434 \:0438 \:0440\:0430\:0437\:043d\:044b\:0445 \:0441\:0438\:0442\:0443\:0430\:0446\:0438\:0439*)


(* ::Text:: *)
(*k=0.01; Re=1;m=2*)


(* ::Text:: *)
(*k=0.01; Re=1;m=1*)


(* ::Text:: *)
(*k=0.01; Re=1;m=0*)


(* ::Text:: *)
(*k=1; Re=1;m=0*)


(* ::Text:: *)
(*k=0.1;Re=1;m=0*)


(* ::Text:: *)
(*k=1;Re=100;m=0*)


(* ::Subsubsection:: *)
(*\:041e\:0442 \:0432\:043e\:043b\:043d\:043e\:0432\:043e\:0433\:043e \:0447\:0438\:0441\:043b\:0430 \:0432\:0434\:043e\:043b\:044c \:043a\:0430\:043d\:0430\:043b\:0430 k*)


(* ::Input:: *)
(*Plot[GetMainIncrement[50,1,k,1000,2],{k,-0.1`,2.3`}]*)


(* ::Graphics:: *)
(*GraphicsData["PostScript", "\<\*)
(*%!*)
(*%%Creator: Mathematica*)
(*%%AspectRatio: .61803 *)
(*MathPictureStart*)
(*/Mabs {*)
(*Mgmatrix idtransform*)
(*Mtmatrix dtransform*)
(*} bind def*)
(*/Mabsadd { Mabs*)
(*3 -1 roll add*)
(*3 1 roll add*)
(*exch } bind def*)
(*%% Graphics*)
(*%%IncludeResource: font Courier*)
(*%%IncludeFont: Courier*)
(*/Courier findfont 10  scalefont  setfont*)
(*% Scaling calculations*)
(*0.063492 0.396825 0.603319 3.42435 [*)
(*[.2619 .59082 -9 -9 ]*)
(*[.2619 .59082 9 0 ]*)
(*[.46032 .59082 -3 -9 ]*)
(*[.46032 .59082 3 0 ]*)
(*[.65873 .59082 -9 -9 ]*)
(*[.65873 .59082 9 0 ]*)
(*[.85714 .59082 -3 -9 ]*)
(*[.85714 .59082 3 0 ]*)
(*[.05099 .00406 -36 -4.5 ]*)
(*[.05099 .00406 0 4.5 ]*)
(*[.05099 .08967 -30 -4.5 ]*)
(*[.05099 .08967 0 4.5 ]*)
(*[.05099 .17527 -36 -4.5 ]*)
(*[.05099 .17527 0 4.5 ]*)
(*[.05099 .26088 -24 -4.5 ]*)
(*[.05099 .26088 0 4.5 ]*)
(*[.05099 .34649 -36 -4.5 ]*)
(*[.05099 .34649 0 4.5 ]*)
(*[.05099 .4321 -30 -4.5 ]*)
(*[.05099 .4321 0 4.5 ]*)
(*[.05099 .51771 -36 -4.5 ]*)
(*[.05099 .51771 0 4.5 ]*)
(*[ 0 0 0 0 ]*)
(*[ 1 .61803 0 0 ]*)
(*] MathScale*)
(*% Start of Graphics*)
(*1 setlinecap*)
(*1 setlinejoin*)
(*newpath*)
(*0 g*)
(*.25 Mabswid*)
(*[ ] 0 setdash*)
(*.2619 .60332 m*)
(*.2619 .60957 L*)
(*s*)
(*[(0.5)] .2619 .59082 0 1 Mshowa*)
(*.46032 .60332 m*)
(*.46032 .60957 L*)
(*s*)
(*[(1)] .46032 .59082 0 1 Mshowa*)
(*.65873 .60332 m*)
(*.65873 .60957 L*)
(*s*)
(*[(1.5)] .65873 .59082 0 1 Mshowa*)
(*.85714 .60332 m*)
(*.85714 .60957 L*)
(*s*)
(*[(2)] .85714 .59082 0 1 Mshowa*)
(*.125 Mabswid*)
(*.10317 .60332 m*)
(*.10317 .60707 L*)
(*s*)
(*.14286 .60332 m*)
(*.14286 .60707 L*)
(*s*)
(*.18254 .60332 m*)
(*.18254 .60707 L*)
(*s*)
(*.22222 .60332 m*)
(*.22222 .60707 L*)
(*s*)
(*.30159 .60332 m*)
(*.30159 .60707 L*)
(*s*)
(*.34127 .60332 m*)
(*.34127 .60707 L*)
(*s*)
(*.38095 .60332 m*)
(*.38095 .60707 L*)
(*s*)
(*.42063 .60332 m*)
(*.42063 .60707 L*)
(*s*)
(*.5 .60332 m*)
(*.5 .60707 L*)
(*s*)
(*.53968 .60332 m*)
(*.53968 .60707 L*)
(*s*)
(*.57937 .60332 m*)
(*.57937 .60707 L*)
(*s*)
(*.61905 .60332 m*)
(*.61905 .60707 L*)
(*s*)
(*.69841 .60332 m*)
(*.69841 .60707 L*)
(*s*)
(*.7381 .60332 m*)
(*.7381 .60707 L*)
(*s*)
(*.77778 .60332 m*)
(*.77778 .60707 L*)
(*s*)
(*.81746 .60332 m*)
(*.81746 .60707 L*)
(*s*)
(*.02381 .60332 m*)
(*.02381 .60707 L*)
(*s*)
(*.89683 .60332 m*)
(*.89683 .60707 L*)
(*s*)
(*.93651 .60332 m*)
(*.93651 .60707 L*)
(*s*)
(*.97619 .60332 m*)
(*.97619 .60707 L*)
(*s*)
(*.25 Mabswid*)
(*0 .60332 m*)
(*1 .60332 L*)
(*s*)
(*.06349 .00406 m*)
(*.06974 .00406 L*)
(*s*)
(*[(-0.175)] .05099 .00406 1 0 Mshowa*)
(*.06349 .08967 m*)
(*.06974 .08967 L*)
(*s*)
(*[(-0.15)] .05099 .08967 1 0 Mshowa*)
(*.06349 .17527 m*)
(*.06974 .17527 L*)
(*s*)
(*[(-0.125)] .05099 .17527 1 0 Mshowa*)
(*.06349 .26088 m*)
(*.06974 .26088 L*)
(*s*)
(*[(-0.1)] .05099 .26088 1 0 Mshowa*)
(*.06349 .34649 m*)
(*.06974 .34649 L*)
(*s*)
(*[(-0.075)] .05099 .34649 1 0 Mshowa*)
(*.06349 .4321 m*)
(*.06974 .4321 L*)
(*s*)
(*[(-0.05)] .05099 .4321 1 0 Mshowa*)
(*.06349 .51771 m*)
(*.06974 .51771 L*)
(*s*)
(*[(-0.025)] .05099 .51771 1 0 Mshowa*)
(*.125 Mabswid*)
(*.06349 .02118 m*)
(*.06724 .02118 L*)
(*s*)
(*.06349 .0383 m*)
(*.06724 .0383 L*)
(*s*)
(*.06349 .05542 m*)
(*.06724 .05542 L*)
(*s*)
(*.06349 .07254 m*)
(*.06724 .07254 L*)
(*s*)
(*.06349 .10679 m*)
(*.06724 .10679 L*)
(*s*)
(*.06349 .12391 m*)
(*.06724 .12391 L*)
(*s*)
(*.06349 .14103 m*)
(*.06724 .14103 L*)
(*s*)
(*.06349 .15815 m*)
(*.06724 .15815 L*)
(*s*)
(*.06349 .1924 m*)
(*.06724 .1924 L*)
(*s*)
(*.06349 .20952 m*)
(*.06724 .20952 L*)
(*s*)
(*.06349 .22664 m*)
(*.06724 .22664 L*)
(*s*)
(*.06349 .24376 m*)
(*.06724 .24376 L*)
(*s*)
(*.06349 .27801 m*)
(*.06724 .27801 L*)
(*s*)
(*.06349 .29513 m*)
(*.06724 .29513 L*)
(*s*)
(*.06349 .31225 m*)
(*.06724 .31225 L*)
(*s*)
(*.06349 .32937 m*)
(*.06724 .32937 L*)
(*s*)
(*.06349 .36361 m*)
(*.06724 .36361 L*)
(*s*)
(*.06349 .38074 m*)
(*.06724 .38074 L*)
(*s*)
(*.06349 .39786 m*)
(*.06724 .39786 L*)
(*s*)
(*.06349 .41498 m*)
(*.06724 .41498 L*)
(*s*)
(*.06349 .44922 m*)
(*.06724 .44922 L*)
(*s*)
(*.06349 .46634 m*)
(*.06724 .46634 L*)
(*s*)
(*.06349 .48347 m*)
(*.06724 .48347 L*)
(*s*)
(*.06349 .50059 m*)
(*.06724 .50059 L*)
(*s*)
(*.06349 .53483 m*)
(*.06724 .53483 L*)
(*s*)
(*.06349 .55195 m*)
(*.06724 .55195 L*)
(*s*)
(*.06349 .56908 m*)
(*.06724 .56908 L*)
(*s*)
(*.06349 .5862 m*)
(*.06724 .5862 L*)
(*s*)
(*.25 Mabswid*)
(*.06349 0 m*)
(*.06349 .61803 L*)
(*s*)
(*0 0 m*)
(*1 0 L*)
(*1 .61803 L*)
(*0 .61803 L*)
(*closepath*)
(*clip*)
(*newpath*)
(*.5 Mabswid*)
(*.02381 .48809 m*)
(*.02605 .48958 L*)
(*.02846 .49129 L*)
(*.03053 .49303 L*)
(*.03163 .49413 L*)
(*.03279 .49556 L*)
(*.03344 .49656 L*)
(*.03416 .4979 L*)
(*.03543 .50129 L*)
(*.03672 .50645 L*)
(*.03793 .51196 L*)
(*.04017 .52097 L*)
(*.04262 .52867 L*)
(*.04517 .53502 L*)
(*.04761 .53988 L*)
(*.05 .54376 L*)
(*.05217 .54661 L*)
(*.05475 .54928 L*)
(*.05607 .55036 L*)
(*.0575 .55132 L*)
(*.05882 .55202 L*)
(*.06005 .55251 L*)
(*.06121 .55284 L*)
(*.06244 .55304 L*)
(*.06309 .55308 L*)
(*.06379 .55309 L*)
(*.06507 .55297 L*)
(*.06631 .5527 L*)
(*.06746 .55232 L*)
(*.0687 .55176 L*)
(*.07006 .55095 L*)
(*.07283 .54873 L*)
(*.07524 .5461 L*)
(*.07784 .54247 L*)
(*.08253 .53337 L*)
(*.08762 .51795 L*)
(*.09042 .50574 L*)
(*.09109 .50296 L*)
(*.09179 .50052 L*)
(*.09306 .49742 L*)
(*.09378 .49618 L*)
(*.09456 .49507 L*)
(*.09619 .49328 L*)
(*.09903 .49092 L*)
(*.10458 .48717 L*)
(*.12462 .46817 L*)
(*.13028 .4601 L*)
(*.13565 .45407 L*)
(*.13818 .45109 L*)
(*.14087 .44845 L*)
(*Mistroke*)
(*.14342 .44665 L*)
(*.14572 .44516 L*)
(*.14802 .44373 L*)
(*.14924 .44298 L*)
(*.15051 .44219 L*)
(*.15164 .44149 L*)
(*.15286 .44255 L*)
(*.15502 .44505 L*)
(*.16027 .44994 L*)
(*.16517 .45317 L*)
(*.16788 .45447 L*)
(*.17045 .45539 L*)
(*.17275 .45599 L*)
(*.17405 .45622 L*)
(*.17526 .45638 L*)
(*.17654 .45649 L*)
(*.17775 .45653 L*)
(*.17844 .45653 L*)
(*.17907 .45652 L*)
(*.17977 .45648 L*)
(*.1805 .45643 L*)
(*.18117 .45636 L*)
(*.18188 .45627 L*)
(*.18316 .45607 L*)
(*.18468 .45575 L*)
(*.18606 .45539 L*)
(*.19092 .45362 L*)
(*.19607 .45097 L*)
(*.20528 .44469 L*)
(*.21532 .43748 L*)
(*.21821 .4358 L*)
(*.22095 .43447 L*)
(*.22345 .4335 L*)
(*.22609 .43268 L*)
(*.23097 .43161 L*)
(*.23548 .43088 L*)
(*.24075 .43008 L*)
(*.24571 .42917 L*)
(*.2499 .42819 L*)
(*.25441 .42686 L*)
(*.26403 .42295 L*)
(*.27359 .4175 L*)
(*.28405 .40971 L*)
(*.30514 .38887 L*)
(*.32637 .36498 L*)
(*.33641 .35534 L*)
(*.34567 .34831 L*)
(*.35529 .34278 L*)
(*.36573 .33829 L*)
(*.38468 .33223 L*)
(*Mistroke*)
(*.42405 .32068 L*)
(*.46191 .3057 L*)
(*.50222 .28336 L*)
(*.54101 .25484 L*)
(*.58225 .21668 L*)
(*.62198 .17265 L*)
(*.63231 .16015 L*)
(*.64203 .14803 L*)
(*.64627 .14264 L*)
(*.6473 .14132 L*)
(*.64841 .13997 L*)
(*.64962 .13946 L*)
(*.65076 .13899 L*)
(*.65567 .13694 L*)
(*.66019 .13505 L*)
(*.67988 .12693 L*)
(*.70086 .11839 L*)
(*.74224 .10189 L*)
(*.78211 .08637 L*)
(*.82045 .07175 L*)
(*.86126 .05648 L*)
(*.90054 .04201 L*)
(*.93831 .0283 L*)
(*.97619 .01472 L*)
(*Mfstroke*)
(*% End of Graphics*)
(*MathPictureEnd*)
(*\*)
(*\>"]*)


(* ::Input:: *)
(*Show[%71,%68]*)


(* ::Input:: *)
(*If[!NumericQ[E],Remove[E]];*)
(*cutout=6;*)
(*ltest=Last/@Drop[linc,cutout];*)
(*{lna\[Lambda],\[Lambda]}=CoefficientList[Fit[Log[-dif[ltest]],{1,x},x],x];*)
(*a=-E^lna\[Lambda]/\[Lambda];Print[{a,\[Lambda]}];*)


(* ::Input:: *)
(*ListPlot[ltest-Table[a \[ExponentialE]^(\[Lambda] x),{x,1,Length[ltest]}]]*)
